perm filename Q3.F4[SAB,LCS] blob sn#356901 filedate 1978-05-22 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION X(14),Y(14),INK(14),IBUF(5000)
C00004 ENDMK
CāŠ—;
	DIMENSION X(14),Y(14),INK(14),IBUF(5000)
	COMMON /FAC/JFAC,KFAC
	DATA X/0.,.7,.7,.6,1.8,2.6,3.1,3.9,3.5,3.4,4.5,4.8,5.,5.3/,
	1 Y/0.,.5,.3,.1,.5,-.3,-.8,.5,.6,.8,1.1,.7,1.,1./,
	1 INK/3,3,3,2,2,2,3,2,2,3,2,2,2,2/
CC	1 INK/3,2,3,2,2,2,3,2,2,3,2,2,2,2/
	TYPE 1
	ACCEPT 2,JFAC,KFAC
	IF(JFAC.EQ.0)JFAC=100
	IF(KFAC.EQ.0)KFAC=100
	CALL PLOT (15.,14.75,-3)
	CX=0.0
	CY=0.0
CC	ANG=5.
  	ANG=1.5 
CC	KK=120
	JJ1=1
  	DO 30 JJ=1,120
	TYPE 2,JJ1
  	KK= 50
CC	DO 30 JJ=1,120
	CALL PLOTS (IBUF,5000,1)
	KK=KK+1
	N=1
  	DO 20 J=1,200
CC	DO 20 J=JJ,KK
        IF(JJ1.EQ.11.OR.
 	1JJ1.EQ.25.OR.
	1JJ1.EQ.34.OR.JJ1.EQ.50.OR.JJ1.EQ.51.OR.JJ1.EQ.54.OR.
	1JJ1.EQ.57.OR.JJ1.EQ.66.OR.JJ1.EQ.74)GO TO 12
	GO TO 20
12 	DO 10 K=1,14
    	CALL PLOT (X(K),Y(K),INK(K))
 10	CONTINUE
	CALL ROTATE (X,Y,14,CX,CY,ANG)
	N=N+1
  	ANG=ANG+.02 
CC	JFAC=JFAC+1
CC	KFAC=KFAC+1
CC 	L=J-10*(J/10)            
CC	IF(L.EQ.0)PAUSE
 20	CONTINUE
	JJ1=JJ1+1

	PAUSE
 30	CONTINUE
	CALL PLOT (0.0,-30.,-3)
	CALL PLOT(0.0,0.0,999)
	STOP
1	FORMAT(' TYPE X FACTOR AND Y FACTOR   '$)
2	FORMAT(2I)
	END